implementation module Scanner;
import StdEnv;

cons c "" xs= xs;
cons c x xs= [(c, x):xs];

/*
Start= tokens [("Int", ['+|-@e[0-9]@+ |\t|\n@b']),
               ("Word", ['[a-z]@+ '])] "45 era uma vez 56\n";
*/

tokens :: ![({#.Char},![.Char])] !{#.Char} -> (.Bool,[.({#Char},{#Char})]);
tokens regs s
  # (xs, i)= wrd regs 0;
  | i > size s - 1= (True, xs);
  = (False, xs);
where
{
  wrd rs i | i > size s= ([], i); // ([], []);
  wrd [] i = ([], i);
  wrd [r:rs] i
   # (classification, tk1, rest)= tokenize i r s;
   | classification <> ""
     # (wds, rchars)= wrd regs rest;
     | rchars > size s - 1  = (cons classification tk1 wds, rchars); 
     = ([], rchars);
   = wrd rs i;
}

isToken :: [Char] String -> Bool;
isToken r s= token 0 (reg r) 
where {
  token i [K p:ps]  | isTrue p s i 
    = token  (i+1) ps;
  token i [BLANK p:ps] | isTrue p s i
     = token (ignore p (i+1)) ps;
  token i [IGNORE p:ps] | isTrue p s i
       = token (i+1) ps;
  token i [IGNORE p:ps] | i < size s 
       = token i ps;
  token i [EPSILON p:ps] | isTrue p s i
       = token (i+1) ps;
  token i [EPSILON p:ps]
     = token i ps;
  token ii [KSTAR p:ps]
     # i= star p ii;
     = token i ps;
  token i [KPLUS p:ps] | isTrue p s i
     # j= star p (i+1);
     = token j ps;
  token i []= i> size s - 1;
  token i ps= False;
  
  ignore p i | isTrue p s i= ignore p (i+1);
  ignore p i= i;
  
  star p i | i > size s - 1 = i;
  star p i | isTrue p s i
    = star p (i+1);
  star p i= i; 
} 

//Start= isToken ['+|-@e[0-9]@+.[0-9]@+'] "-2.34";
//Start= words [',.;?'] "era, uma +23.6e+5.6 vezes. Outras vezes?\n";

//words :: [.Char] !{#.Char} -> .[{#Char}];
words :: [Char] String -> [String];
words seps s = loop 0;
where {
 loop i 
  | i > size s - 1= [];
  | isMember s.[i] seps= [s%(i,i):loop (i+1)];
  | s.[i]==' '= loop (i+1);
  | s.[i]=='\n'= loop (i+1);
  | s.[i]=='\t'= loop (i+1);
  | maybeNumber i= getnumber False i i;
  = getword i i;
 getword i j
   | j > size s - 1 = [];
   | isMember s.[j] seps= [s%(i, j-1):loop j];
   | s.[j] == ' '= [s%(i, j-1): loop j]; 
   | s.[j] == '\n'= [s%(i, j-1): loop j];
   | j+1 > size s - 1= [s%(i, j)];
   = getword i (j+1);
   
 getnumber foundDot i j
   | j > size s - 1 = [];
   | s.[j]== '.' && not foundDot= getnumber True i (j+1);
   | isMember s.[j] seps= [s%(i, j-1):loop j];
   | s.[j] == ' '= [s%(i, j-1): loop j]; 
   | s.[j] == '\n'= [s%(i, j-1): loop j];
   | j+1 > size s - 1= [s%(i, j)];
   = getnumber foundDot i (j+1);
   
 maybeNumber i
   | i < size s && (isMember s.[i] ['+-']) =
         oneDigit (i+1) ;
   | i < size s && isDigit s.[i]= restNumber (i+1);
   = False;
 oneDigit i
   | i < size s && isDigit s.[i]= restNumber (i+1);
   = False;
 restNumber i
   | i > size s - 1= True; // End of string;
   | s.[i]== '.'= fraction (i+1); // Dot
   | isMember s.[i] seps= True; 
   | s.[i]== ' '= True;
   | s.[i]== '\n'= True;
   | s.[i]== '\t'= True;
   | s.[i]== 'e'= exponent (i+1);
   | isDigit s.[i]= restNumber (i+1);
   = False;
   
 exponent i
   | i < size s - 1 && (isMember s.[i] ['+-'])
           && isDigit s.[i+1] = restExponent 1 (i+1+1) ;
   | i < size s && isDigit s.[i]= restExponent 1 (i+1);
   = False; 
 restExponent n i
   | i > size s - 1 = True;
   | n > 2= False;
   | isMember s.[i] seps= True;
   | s.[i]== ' '= True;
   | s.[i]== '\n'= True;
   | s.[i]== '\t'= True;
   | isDigit s.[i]= restExponent (n+1) (i+1);
   = False;
  
  fraction i
    | i > size s - 1 = True;
    | isMember s.[i] seps= True;
    | s.[i]== ' '= True;
    | s.[i]== '\n'= True;
    | s.[i]== '\t'= True;
    | s.[i]== 'e'= exponent (i+1);
    | isDigit s.[i]= fraction (i+1);
    = False;
  
}



/*
words :: ![[Char]] !{#Char} -> (Bool,[{#Char}]);
words regs s
  # (xs, i)= wrd regs 0;
  | i > size s - 1= (True, xs);
  = (False, xs);
where
{ 
  cns  "" xs= xs;
  cns  x xs= [x:xs];

  wrd rs i | i > size s= ([], i); // ([], []);
  wrd [] i = ([], i);
  wrd [r:rs] i
   # (classification, tk1, rest)= tokenize i ("reco", r) s;
   | classification <> ""
     # (wds, rchars)= wrd regs rest;
     | rchars > size s - 1  = (cns tk1 wds, rchars); 
     = ([], rchars);
   = wrd rs i;
}
*/

isTrue p s i :== i < size s && p s.[i];

tokenize :: .Int !(u:{#.Char},![.Char]) {#.Char} 
      -> (v:{#Char},{#Char},Int), [u <= v];
tokenize i (classification, r) s
  # (ok, tk, pos)= token i (reg r)
  | ok= (classification, tk, pos)
  = ("", tk, pos);
where{
  ignore p i | isTrue p s i= ignore p (i+1);
  ignore p i= i;
   
  token i [K p:ps]  | isTrue p s i 
    # (ok, tk2, j)= token  (i+1) ps;
    | not ok= (False, "", i);
    # tk1= s%(i, i);
    = (True, tk1+++tk2, j);
  token i [BLANK p:ps] | isTrue p s i
    # (ok, tk2, j)= token (ignore p (i+1)) ps;
    | not ok= (False, "", i);
    = (True, tk2, j);
  token i [IGNORE p:ps] | isTrue p s i
     # (ok, tk, j)= token (i+1) ps;
     | not ok= (False, "", i);
     = (True, tk, j);
  token i [IGNORE p:ps] | i < size s 
     # (ok, tk, j)= token i ps;
     | not ok= (False, "", i);
     = (True, tk, j);
  token i [EPSILON p:ps] | isTrue p s i
     # tk1= s%(i, i);
       (ok, tk2, j)= token (i+1) ps;
     | ok= (True, tk1+++tk2, j);
     = (False, "", i);
  token i [EPSILON p:ps]
     # (ok, tk, j)= token i ps;
     | ok = (True, tk, j);
     = (False, "", i);
  token ii [KSTAR p:ps]
     # (s, i)= star p ii;
       (ok, ss, j)= token i ps;
     | ok= (True, s+++ss, j);
     = (False, "", ii);
  token i [KPLUS p:ps] | isTrue p s i
     # tk= s%(i,i);
       (s, i)= star p (i+1);
       (ok, ss, j)= token i ps;
     | ok= (True, tk+++s+++ss, j);
     = (False, "", i); 
  token i []= (True, "", i);
  token i ps= (False, "", i);
  
  star p i | i > size s - 1 = ("", i);
  star p i | isTrue p s i
    # x= s%(i,i);
    # (s, j)= star p (i+1);
    = (x+++s, j);
  star p i= ("", i); 
  }  


:: KLEENE=  KSTAR (Char -> Bool) 
          | KPLUS (Char -> Bool) 
          | K (Char -> Bool)
          | EPSILON (Char -> Bool)
          | BLANK (Char -> Bool)
          | IGNORE (Char -> Bool)
          | ANY (Char -> Bool); 

moreor ['|',x:xs]
  # (orargs, rest)= moreor xs;
  = ([x:orargs], rest);
moreor xs= ([], xs);

moreSet [x, ']':xs]= (True, \c= x==c, xs);
moreSet [x,'-',y, ']':xs]= (True, \c= isMember c [x..y], xs);
moreSet [x, ',':xs]
   # (ok, p, rest)= moreSet xs;
   | not ok= (False, \c= False, xs);
   = (True, \c= (p c) || x==c, rest);
moreSet [x, '-', y, ',':xs]
   # (ok, p, rest)= moreSet xs;
   | not ok= (False, \c= False, xs);
   = (True, \c= (p c) || isMember c [x..y], rest);
moreSet xs= (False, \c= False, xs);

regSet ['[', '@', '~', x,'-',y, ']':xs]
    = (True, \c= not(isMember c [x..y]), xs);
regSet ['[', '@', '~', x,']':xs]= (True, \c= not(x==c), xs);

regSet ['[','@', '~', ']':xs]= (True, \c= True, xs);
regSet ['[', '@', '~':xs]
  # (ok, p, rest) = moreSet xs;
  | not ok= (False, \c= False, xs);
  = (True, not o p, rest);

regSet ['[',x,'-',y, ']':xs]= (True, \c= isMember c [x..y], xs);
regSet ['[',x,']':xs]= (True, \c= x==c, xs);
regSet ['[',']':xs]= (True, \c= False, xs);
regSet ['[':xs]= moreSet xs;
regSet xs= (False, \c=False, xs);

isOr ['|':xs]= True;
isOr xs= False;


restOr ['|', x:xs]
    # (ok, p, rest)= regSet [x:xs];
    | not ok
        # (p2, rest)= restOr xs;
        = (\c= (p2 c) || (x==c), rest);
    # (p2, rest)= restOr rest;
    = (\c= (p c) || (p2 c), rest);
restOr ['|']= (\c=False, []);
restOr xs= (\c= False, xs); 

cc ['[',x,'-',y, ']':xs]= kleene (\c= isMember c [x..y]) xs;
cc ['[':xs]
  # (ok, p, rest)= regSet ['[':xs];
  | not ok= kleene (\c= c=='[') xs;
  | isOr rest
       # (p2, rest)= restOr rest;
       = kleene (\c= (p c) || (p2 c)) rest;
  = kleene p rest;
cc [x, '|':xs]
  # (p, rest)= restOr ['|':xs]
  = kleene (\c= x==c || p c) rest;
cc ['@', '.':xs] = kleene (\c-> True) xs;
cc [x:xs]= kleene (\c= x==c) xs;

kleene p ['@','*':xs]= (KSTAR p, xs);
kleene p ['@','+':xs]= (KPLUS p, xs);
kleene p ['@', 'e':xs]= (EPSILON p, xs);
kleene p ['@','b':xs]= (BLANK p, xs);
kleene p ['@', 'i':xs]= (IGNORE p, xs);
kleene p xs= (K p, xs);

//reg:: ![Char] -> [KLEENE];
reg []= [];
reg xs
  # (p, xs)= cc xs;
  = [p:reg xs];

//Start= isToken ['5|[a-z,A-Z,2]|[3-4]@+'] "Aba3c5a4te";
//Start= isToken ['5|6|7@+'] "7576";
//Start= isToken ['[@~0-9,b]@+'] "gah.d";

concat :: String [String] -> String;
concat sep []= "";
concat sep [x]= x;
concat sep [x:xs]= x+++sep+++(concat sep xs);

freadlines :: {#Char} *File -> ({#Char},.File);
freadlines x std
   # (n, std)= freadline std;
   | n== "\n" = (x, std);
   = freadlines (x+++n) std;
   
/*
wordsFromFile :: [[.Char]] {#.Char} *a 
        -> *([{#Char}],*a) | FileSystem a;
wordsFromFile reg fileName world
  # (ok, infile, world)= fopen fileName FReadText world;
    (contents, infile)= freads infile 64000;
    (ok1, ws)= words (reg++[['@.@i']]) contents;
    (ok, world)= fclose infile world;
  |  ok1 && ok = (ws, world);
  = ([], world);

wordsToFile :: [{#.Char}] {#.Char} *a -> *a | FileSystem a;
wordsToFile ws fileName world
  # (ok, outfile, world)= fopen fileName FWriteText world;
    outfile= fwrites (concat " " ws) outfile;
    (ok,  world)= fclose outfile world;
  = world;



*/